home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjoc85.arc / PENT.F77 < prev    next >
Text File  |  1985-05-15  |  3KB  |  160 lines
  1. *     SOURCE FILE:   PENT.F77
  2. *     EDIT DATE:     18MAR85
  3. *     AUTHOR:        A. J. HOWARD
  4. *
  5. *     PENTATHLON PROGRAM, FORTRAN 77 VERSION
  6.  
  7.       PROGRAM PENT
  8.  
  9.       INTEGER*2   I, ITER, BENCH
  10.       INTEGER*2   E (4), S (4)
  11.  
  12. 1     WRITE  (*, *)' Benchmark: '
  13.       READ   (*, *)BENCH
  14.       IF (BENCH .LE. 0)STOP
  15.       WRITE  (*, *)' Iterations: '
  16.       READ   (*, *)ITER
  17.  
  18.       CALL TIME (S)
  19.       DO 30 I = 1, ITER
  20.          GO TO (100, 200, 300, 400, 500), BENCH
  21. 100         CALL BENCH1
  22.             GO TO 30
  23.  
  24. 200         CALL BENCH2
  25.             GO TO 30
  26.  
  27. 300         CALL BENCH3
  28.             GO TO 30
  29.  
  30. 400         CALL BENCH4
  31.             GO TO 30
  32.  
  33. 500         CALL BENCH5
  34. 30    CONTINUE
  35.  
  36.       CALL ETIME (E, S, ITER)
  37.       WRITE  (*, *)' DONE- '
  38.       GO TO 1
  39.       END
  40. *     FLOATING POINT ARITHMETIC BENCHMARK
  41.       SUBROUTINE BENCH1
  42.  
  43.       INTEGER*2   I, J
  44.       REAL        X (100), Y (100), Z
  45.  
  46.       DO 10 I = 1, 100
  47.          X (I) = I + 1
  48.          Y (I) = 3*I
  49. 10       CONTINUE
  50.  
  51.       Z = 0.0
  52.       DO 20 J = 1, 10
  53.          DO 20 I = 1, 100
  54.             Z = Z + X (I)*Y (I)
  55. 20          CONTINUE
  56.  
  57.       RETURN
  58.       END
  59. *     FUNCTION CALLING BENCHMARK
  60.       SUBROUTINE BENCH2
  61.  
  62.       INTEGER*2   I, RESULT
  63.       INTEGER*2   DUMMY
  64.  
  65.       DO 10 I = 1, 20000
  66.          RESULT = DUMMY (I)
  67. 10       CONTINUE
  68.  
  69.       RETURN
  70.       END
  71.  
  72.       INTEGER*2 FUNCTION DUMMY (I)
  73.       INTEGER*2                 I
  74.  
  75.       DUMMY = I + 1
  76.       RETURN
  77.       END
  78. *     STRING COPY BENCHMARK
  79.       SUBROUTINE BENCH3
  80.  
  81.       INTEGER*2      I, J
  82.       CHARACTER*127  S, S2
  83.  
  84.       DO 10 I = 1, 127
  85.          S (I: I) = 'A'
  86. 10       CONTINUE
  87.  
  88.       DO 20 I = 1, 100
  89.          DO 20 J = 1, 127
  90.             S2 (J: J) = S (J: J)
  91. 20          CONTINUE
  92.  
  93.       RETURN
  94.       END
  95. *     CHARACTER COUNT BENCHMARK
  96.       SUBROUTINE BENCH4
  97.  
  98.       INTEGER*2      I, J, COUNT (64)
  99.       CHARACTER*127  S
  100.  
  101.       DO 10 I = 1, 127
  102.          J = I
  103.          S (I: I) = CHAR (J)
  104. 10       CONTINUE
  105.  
  106.       DO 20 J = 1, 200
  107.          CALL COUNTC (S, COUNT)
  108. 20       CONTINUE
  109.  
  110.       RETURN
  111.       END
  112.  
  113.  
  114.       SUBROUTINE COUNTC (S, COUNT)
  115.       CHARACTER*127      S
  116.       INTEGER*2             COUNT (64)
  117.  
  118.       INTEGER*2   I, C
  119.  
  120.       DO 10 I = 1, 127
  121.          C = MOD (ICHAR (S (I: I)), 63) + 1
  122.          COUNT (C) = COUNT (C) + 1
  123. 10       CONTINUE
  124.  
  125.       RETURN
  126.       END
  127. *     FILE COPY CHARACTER BY CHARACTER
  128.       SUBROUTINE BENCH5
  129.  
  130.       INTEGER*2   IN, OUT
  131.       INTEGER*2   N
  132.       CHARACTER   C
  133.  
  134.       IN = 1
  135.       OUT = 2
  136.       OPEN (IN,  FILE   = 'A:TEST.IN',  
  137.      1           STATUS = 'OLD', 
  138.      1           FORM   = 'UNFORMATTED')
  139.       OPEN (OUT, FILE   = 'A:TEST.OUT', 
  140.      1           STATUS = 'NEW', 
  141.      1           FORM   = 'UNFORMATTED')
  142.  
  143.       N = 0
  144. 10    READ (IN, END = 20, ERR = 110) C
  145.       N = N + 1
  146.       WRITE (OUT, ERR = 120) C
  147.       GO TO 10
  148.  
  149. 20    WRITE  (*, *) N, ' CHARACTERS'
  150.       CLOSE (IN)
  151.       CLOSE (OUT)
  152.       RETURN
  153.  
  154. 110   WRITE  (*, *)'*** Read Error ***'
  155.       STOP
  156.  
  157. 120   WRITE  (*, *)'*** Write Error ***'
  158.       STOP
  159.       END
  160.